home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / MacPerl 5.1.3 / Mac_Perl_513_src / perl5.002 / pod / pod2man < prev    next >
Encoding:
Text File  |  1997-01-21  |  25.0 KB  |  1,051 lines  |  [TEXT/MPS ]
  1. Perl -Sx "{0}" {"Parameters"}; Exit {Status}
  2. #!perl
  3. eval 'exec perl -S $0 "$@"'
  4.     if 0;
  5.  
  6. =head1 NAME
  7.  
  8. pod2man - translate embedded Perl pod directives into man pages
  9.  
  10. =head1 SYNOPSIS
  11.  
  12. B<pod2man>
  13. [ B<--section=>I<manext> ]
  14. [ B<--release=>I<relpatch> ]
  15. [ B<--center=>I<string> ]
  16. [ B<--date=>I<string> ]
  17. [ B<--fixed=>I<font> ]
  18. [ B<--official> ]
  19. I<inputfile>
  20.  
  21. =head1 DESCRIPTION
  22.  
  23. B<pod2man> converts its input file containing embedded pod directives (see
  24. L<perlpod>) into nroff source suitable for viewing with nroff(1) or
  25. troff(1) using the man(7) macro set.
  26.  
  27. Besides the obvious pod conversions, B<pod2man> also takes care of
  28. func(), func(n), and simple variable references like $foo or @bar so
  29. you don't have to use code escapes for them; complex expressions like
  30. C<$fred{'stuff'}> will still need to be escaped, though.  Other nagging
  31. little roffish things that it catches include translating the minus in
  32. something like foo-bar, making a long dash--like this--into a real em
  33. dash, fixing up "paired quotes", putting a little space after the
  34. parens in something like func(), making C++ and PI look right, making
  35. double underbars have a little tiny space between them, making ALLCAPS
  36. a teeny bit smaller in troff(1), and escaping backslashes so you don't
  37. have to.
  38.  
  39. =head1 OPTIONS
  40.  
  41. =over 8
  42.  
  43. =item center
  44.  
  45. Set the centered header to a specific string.  The default is
  46. "User Contributed Perl Documentation", unless the C<--official> flag is
  47. given, in which case the default is "Perl Programmers Reference Guide".
  48.  
  49. =item date
  50.  
  51. Set the left-hand footer string to this value.  By default,
  52. the modification date of the input file will be used.
  53.  
  54. =item fixed
  55.  
  56. The fixed font to use for code refs.  Defaults to CW.
  57.  
  58. =item official
  59.  
  60. Set the default header to indicate that this page is of
  61. the standard release in case C<--center> is not given.
  62.  
  63. =item release
  64.  
  65. Set the centered footer.  By default, this is the current
  66. perl release.
  67.  
  68. =item section
  69.  
  70. Set the section for the C<.TH> macro.  The standard conventions on
  71. sections are to use 1 for user commands,  2 for system calls, 3 for
  72. functions, 4 for devices, 5 for file formats, 6 for games, 7 for
  73. miscellaneous information, and 8 for administrator commands.  This works
  74. best if you put your Perl man pages in a separate tree, like
  75. F</usr/local/perl/man/>.  By default, section 1 will be used
  76. unless the file ends in F<.pm> in which case section 3 will be selected.
  77.  
  78. =back
  79.  
  80. =head1 Anatomy of a Proper Man Page
  81.  
  82. For those not sure of the proper layout of a man page, here's
  83. an example of the skeleton of a proper man page.  Head of the
  84. major headers should be setout as a C<=head1> directive, and
  85. are historically written in the rather startling ALL UPPER CASE
  86. format, although this is not mandatory.
  87. Minor headers may be included using C<=head2>, and are
  88. typically in mixed case.
  89.  
  90. =over 10
  91.  
  92. =item NAME
  93.  
  94. Mandatory section; should be a comma-separated list of programs or
  95. functions documented by this podpage, such as:
  96.  
  97.     foo, bar - programs to do something
  98.  
  99. =item SYNOPSIS
  100.  
  101. A short usage summary for programs and functions, which
  102. may someday be deemed mandatory.
  103.  
  104. =item DESCRIPTION
  105.  
  106. Long drawn out discussion of the program.  It's a good idea to break this
  107. up into subsections using the C<=head2> directives, like
  108.  
  109.     =head2 A Sample Subection
  110.  
  111.     =head2 Yet Another Sample Subection
  112.  
  113. =item OPTIONS
  114.  
  115. Some people make this separate from the description.
  116.  
  117. =item RETURN VALUE
  118.  
  119. What the program or function returns if successful.
  120.  
  121. =item ERRORS
  122.  
  123. Exceptions, return codes, exit stati, and errno settings.
  124.  
  125. =item EXAMPLES
  126.  
  127. Give some example uses of the program.
  128.  
  129. =item ENVIRONMENT
  130.  
  131. Envariables this program might care about.
  132.  
  133. =item FILES
  134.  
  135. All files used by the program.  You should probably use the FE<lt>E<gt>
  136. for these.
  137.  
  138. =item SEE ALSO
  139.  
  140. Other man pages to check out, like man(1), man(7), makewhatis(8), or catman(8).
  141.  
  142. =item NOTES
  143.  
  144. Miscellaneous commentary.
  145.  
  146. =item CAVEATS
  147.  
  148. Things to take special care with; sometimes called WARNINGS.
  149.  
  150. =item DIAGNOSTICS
  151.  
  152. All possible messages the program can print out--and
  153. what they mean.
  154.  
  155. =item BUGS
  156.  
  157. Things that are broken or just don't work quite right.
  158.  
  159. =item RESTRICTIONS
  160.  
  161. Bugs you don't plan to fix :-)
  162.  
  163. =item AUTHOR
  164.  
  165. Who wrote it (or AUTHORS if multiple).
  166.  
  167. =item HISTORY
  168.  
  169. Programs derived from other sources sometimes have this, or
  170. you might keep a modification long here.
  171.  
  172. =back
  173.  
  174. =head1 EXAMPLES
  175.  
  176.     pod2man program > program.1
  177.     pod2man some_module.pm > /usr/perl/man/man3/some_module.3
  178.     pod2man --section=7 note.pod > note.7
  179.  
  180. =head1 DIAGNOSTICS
  181.  
  182. The following diagnostics are generated by B<pod2man>.  Items
  183. marked "(W)" are non-fatal, whereas the "(F)" errors will cause
  184. B<pod2man> to immediately exit with a non-zero status.
  185.  
  186. =over 4
  187.  
  188. =item bad option in paragraph %d of %s: ``%s'' should be [%s]<%s>
  189.  
  190. (W) If you start include an option, you should set it off
  191. as bold, italic, or code.
  192.  
  193. =item can't open %s: %s
  194.  
  195. (F) The input file wasn't available for the given reason.
  196.  
  197. =item high bit char in input stream
  198.  
  199. (W) You can't use high-bit characters in the input stream,
  200. because the translator uses them for its own nefarious purposes.
  201. Use an HTML entity in angle brackets instead.
  202.  
  203. =item Improper man page - no dash in NAME header in paragraph %d of %s
  204.  
  205. (W) The NAME header did not have an isolated dash in it.  This is
  206. considered important.
  207.  
  208. =item Invalid man page - no NAME line in %s
  209.  
  210. (F) You did not include a NAME header, which is essential.
  211.  
  212. =item roff font should be 1 or 2 chars, not `%s'  (F)
  213.  
  214. (F) The font specified with the C<--fixed> option was not
  215. a one- or two-digit roff font.
  216.  
  217. =item %s is missing required section: %s
  218.  
  219. (W) Required sections include NAME, DESCRIPTION, and if you're
  220. using a section starting with a 3, also a SYNOPSIS.  Actually,
  221. not having a NAME is a fatal.
  222.  
  223. =item Unknown escape: %s in %s
  224.  
  225. (W) An unknown HTML entity (probably for an 8-bit character) was given via
  226. a C<E<lt>E<gt>> directive.  Besides amp, lt, gt, and quot, recognized
  227. entities are Aacute, aacute, Acirc, acirc, AElig, aelig, Agrave, agrave,
  228. Aring, aring, Atilde, atilde, Auml, auml, Ccedil, ccedil, Eacute, eacute,
  229. Ecirc, ecirc, Egrave, egrave, ETH, eth, Euml, euml, Iacute, iacute, Icirc,
  230. icirc, Igrave, igrave, Iuml, iuml, Ntilde, ntilde, Oacute, oacute, Ocirc,
  231. ocirc, Ograve, ograve, Oslash, oslash, Otilde, otilde, Ouml, ouml, szlig,
  232. THORN, thorn, Uacute, uacute, Ucirc, ucirc, Ugrave, ugrave, Uuml, uuml,
  233. Yacute, yacute, and yuml.
  234.  
  235. =item Unmatched =back
  236.  
  237. (W) You have a C<=back> without a corresponding C<=over>.
  238.  
  239. =item Unrecognized pod directive: %s
  240.  
  241. (W) You specified a pod directive that isn't in the known list of
  242. C<=head1>, C<=head2>, C<=item>, C<=over>, C<=back>, or C<=cut>.
  243.  
  244.  
  245. =back
  246.  
  247. =head1 NOTES
  248.  
  249. If you would like to print out a lot of man page continuously, you
  250. probably want to set the C and D registers to set contiguous page
  251. numbering and even/odd paging, at least one some versions of man(7).
  252. Settting the F register will get you some additional experimental
  253. indexing:
  254.  
  255.     troff -man -rC1 -rD1 -rF1 perl.1 perldata.1 perlsyn.1 ...
  256.  
  257. The indexing merely outputs messages via C<.tm> for each
  258. major page, section, subsection, item, and any C<XE<lt>E<gt>>
  259. directives.
  260.  
  261.  
  262. =head1 RESTRICTIONS
  263.  
  264. You shouldn't use 8-bit characters in the input stream, as these
  265. will be used by the translator.
  266.  
  267. =head1 BUGS
  268.  
  269. The =over and =back directives don't really work right.  They
  270. take absolute positions instead of offsets, don't nest well, and
  271. making people count is suboptimal in any event.
  272.  
  273. =head1 AUTHORS
  274.  
  275. Original prototype by Larry Wall, but so massively hacked over by
  276. Tom Christiansen such that Larry probably doesn't recognize it anymore.
  277.  
  278. =cut
  279.  
  280. $/ = "";
  281. $cutting = 1;
  282.  
  283. if ($^O eq 'MacOS') {
  284.     $DEF_RELEASE = "perl $]";
  285. } else {
  286.     ($version,$patch) = `\PATH=.:..:\$PATH; perl -v` =~ /version (\d\.\d{3}(?: +)(?:\S+)?)(?:.*patchlevel (\d\S*))?/s;
  287.     $DEF_RELEASE  = "perl $version";
  288.     $DEF_RELEASE .= ", patch $patch" if $patch;
  289. }
  290.  
  291. sub makedate {
  292.     my $secs = shift;
  293.     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs);
  294.     my $mname = (qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec})[$mon];
  295.     return "$mday/$mname/$year";
  296. }
  297.  
  298. use Getopt::Long;
  299.  
  300. $DEF_SECTION = 1;
  301. $DEF_CENTER = "User Contributed Perl Documentation";
  302. $STD_CENTER = "Perl Programmers Reference Guide";
  303. $DEF_FIXED = 'CW';
  304.  
  305. sub usage {
  306.     warn "$0: @_\n" if @_;
  307.     die <<EOF;
  308. usage: $0 [options] podpage
  309. Options are:
  310.     --section=manext      (default "$DEF_SECTION")
  311.     --release=relpatch    (default "$DEF_RELEASE")
  312.     --center=string       (default "$DEF_CENTER")
  313.     --date=string         (default "$DEF_DATE")
  314.     --fixed=font          (default "$DEF_FIXED")
  315.     --official          (default NOT)
  316. EOF
  317. }
  318.  
  319. $uok = GetOptions( qw(
  320.     section=s
  321.     release=s
  322.     center=s
  323.     date=s
  324.     fixed=s
  325.     official
  326.     help));
  327.  
  328. $DEF_DATE = makedate((stat($ARGV[0]))[9] || time());
  329.  
  330. usage("Usage error!") unless $uok;
  331. usage() if $opt_help;
  332. usage("Need one and only one podpage argument") unless @ARGV == 1;
  333.  
  334. $section = $opt_section || ($ARGV[0] =~ /\.pm$/ ? 3 : $DEF_SECTION);
  335. $RP = $opt_release || $DEF_RELEASE;
  336. $center = $opt_center || ($opt_official ? $STD_CENTER : $DEF_CENTER);
  337.  
  338. $CFont = $opt_fixed || $DEF_FIXED;
  339.  
  340. if (length($CFont) == 2) {
  341.     $CFont_embed = "\\f($CFont";
  342. }
  343. elsif (length($CFont) == 1) {
  344.     $CFont_embed = "\\f$CFont";
  345. }
  346. else {
  347.     die "roff font should be 1 or 2 chars, not `$CFont_embed'";
  348. }
  349.  
  350. $section = $opt_section || $DEF_SECTION;
  351. $date = $opt_date || $DEF_DATE;
  352.  
  353. for (qw{NAME DESCRIPTION}) {
  354. # for (qw{NAME DESCRIPTION AUTHOR}) {
  355.     $wanna_see{$_}++;
  356. }
  357. $wanna_see{SYNOPSIS}++ if $section =~ /^3/;
  358.  
  359.  
  360. $name = @ARGV ? $ARGV[0] : "<STDIN>";
  361. $Filename = $name;
  362. $name = uc($name) if $section =~ /^1/;
  363. $name =~ s/\.[^.]*$//;
  364.  
  365. if ($name ne 'something') {
  366.     FCHECK: {
  367.     open(F, "< $ARGV[0]") || die "can't open $ARGV[0]: $!";
  368.     while (<F>) {
  369.         next unless /^=\b/;
  370.         if (/^=head1\s+NAME\s*$/) {  # an /m would forgive mistakes
  371.         $_ = <F>;
  372.         unless (/\s*-+\s+/) {
  373.             $oops++;
  374.             warn "$0: Improper man page - no dash in NAME header in paragraph $. of $ARGV[0]\n"
  375.         }
  376.         %namedesc = split /\s+-\s+/;
  377.         last FCHECK;
  378.         }
  379.         next if /^=cut\b/;    # DB_File and Net::Ping have =cut before NAME
  380.         die "$0: Invalid man page - 1st pod line is not NAME in $ARGV[0]\n";
  381.     }
  382.     die "$0: Invalid man page - no documentation in $ARGV[0]\n";
  383.     }
  384.     close F;
  385. }
  386.  
  387. print <<"END";
  388. .rn '' }`
  389. ''' \$RCSfile\$\$Revision\$\$Date\$
  390. '''
  391. ''' \$Log\$
  392. '''
  393. .de Sh
  394. .br
  395. .if t .Sp
  396. .ne 5
  397. .PP
  398. \\fB\\\\\$1\\fR
  399. .PP
  400. ..
  401. .de Sp
  402. .if t .sp .5v
  403. .if n .sp
  404. ..
  405. .de Ip
  406. .br
  407. .ie \\\\n(.\$>=3 .ne \\\\\$3
  408. .el .ne 3
  409. .IP "\\\\\$1" \\\\\$2
  410. ..
  411. .de Vb
  412. .ft $CFont
  413. .nf
  414. .ne \\\\\$1
  415. ..
  416. .de Ve
  417. .ft R
  418.  
  419. .fi
  420. ..
  421. '''
  422. '''
  423. '''     Set up \\*(-- to give an unbreakable dash;
  424. '''     string Tr holds user defined translation string.
  425. '''     Bell System Logo is used as a dummy character.
  426. '''
  427. .tr \\(*W-|\\(bv\\*(Tr
  428. .ie n \\{\\
  429. .ds -- \\(*W-
  430. .ds PI pi
  431. .if (\\n(.H=4u)&(1m=24u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-12u'-\\" diablo 10 pitch
  432. .if (\\n(.H=4u)&(1m=20u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-8u'-\\" diablo 12 pitch
  433. .ds L" ""
  434. .ds R" ""
  435. .ds L' '
  436. .ds R' '
  437. 'br\\}
  438. .el\\{\\
  439. .ds -- \\(em\\|
  440. .tr \\*(Tr
  441. .ds L" ``
  442. .ds R" ''
  443. .ds L' `
  444. .ds R' '
  445. .ds PI \\(*p
  446. 'br\\}
  447. END
  448.  
  449. print <<'END';
  450. .\"    If the F register is turned on, we'll generate
  451. .\"    index entries out stderr for the following things:
  452. .\"        TH    Title 
  453. .\"        SH    Header
  454. .\"        Sh    Subsection 
  455. .\"        Ip    Item
  456. .\"        X<>    Xref  (embedded
  457. .\"    Of course, you have to process the output yourself
  458. .\"    in some meaninful fashion.
  459. .if \nF \{
  460. .de IX
  461. .tm Index:\\$1\t\\n%\t"\\$2"
  462. ..
  463. .nr % 0
  464. .rr F
  465. .\}
  466. END
  467.  
  468. print <<"END";
  469. .TH $name $section "$RP" "$date" "$center"
  470. .IX Title "$name $section"
  471. .UC
  472. END
  473.  
  474. while (($name, $desc) = each %namedesc) {
  475.     for ($name, $desc) { s/^\s+//; s/\s+$//; }
  476.     print qq(.IX Name "$name - $desc"\n);
  477. }
  478.  
  479. print <<'END';
  480. .if n .hy 0
  481. .if n .na
  482. .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
  483. .de CQ          \" put $1 in typewriter font
  484. END
  485. print ".ft $CFont\n";
  486. print <<'END';
  487. 'if n "\c
  488. 'if t \\&\\$1\c
  489. 'if n \\&\\$1\c
  490. 'if n \&"
  491. \\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7
  492. '.ft R
  493. ..
  494. .\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2
  495. .    \" AM - accent mark definitions
  496. .bd B 3
  497. .    \" fudge factors for nroff and troff
  498. .if n \{\
  499. .    ds #H 0
  500. .    ds #V .8m
  501. .    ds #F .3m
  502. .    ds #[ \f1
  503. .    ds #] \fP
  504. .\}
  505. .if t \{\
  506. .    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
  507. .    ds #V .6m
  508. .    ds #F 0
  509. .    ds #[ \&
  510. .    ds #] \&
  511. .\}
  512. .    \" simple accents for nroff and troff
  513. .if n \{\
  514. .    ds ' \&
  515. .    ds ` \&
  516. .    ds ^ \&
  517. .    ds , \&
  518. .    ds ~ ~
  519. .    ds ? ?
  520. .    ds ! !
  521. .    ds /
  522. .    ds q
  523. .\}
  524. .if t \{\
  525. .    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
  526. .    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
  527. .    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
  528. .    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
  529. .    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
  530. .    ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10'
  531. .    ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m'
  532. .    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
  533. .    ds q o\h'-\w'o'u*8/10'\s-4\v'.4m'\z\(*i\v'-.4m'\s+4\h'\w'o'u*8/10'
  534. .\}
  535. .    \" troff and (daisy-wheel) nroff accents
  536. .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
  537. .ds 8 \h'\*(#H'\(*b\h'-\*(#H'
  538. .ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#]
  539. .ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u'
  540. .ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u'
  541. .ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#]
  542. .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
  543. .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
  544. .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
  545. .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
  546. .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
  547. .ds ae a\h'-(\w'a'u*4/10)'e
  548. .ds Ae A\h'-(\w'A'u*4/10)'E
  549. .ds oe o\h'-(\w'o'u*4/10)'e
  550. .ds Oe O\h'-(\w'O'u*4/10)'E
  551. .    \" corrections for vroff
  552. .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
  553. .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
  554. .    \" for low resolution devices (crt and lpr)
  555. .if \n(.H>23 .if \n(.V>19 \
  556. \{\
  557. .    ds : e
  558. .    ds 8 ss
  559. .    ds v \h'-1'\o'\(aa\(ga'
  560. .    ds _ \h'-1'^
  561. .    ds . \h'-1'.
  562. .    ds 3 3
  563. .    ds o a
  564. .    ds d- d\h'-1'\(ga
  565. .    ds D- D\h'-1'\(hy
  566. .    ds th \o'bp'
  567. .    ds Th \o'LP'
  568. .    ds ae ae
  569. .    ds Ae AE
  570. .    ds oe oe
  571. .    ds Oe OE
  572. .\}
  573. .rm #[ #] #H #V #F C
  574. END
  575.  
  576. $indent = 0;
  577.  
  578. while (<>) {
  579.     if ($cutting) {
  580.     next unless /^=/;
  581.     $cutting = 0;
  582.     }
  583.     chomp;
  584.  
  585.     # Translate verbatim paragraph
  586.  
  587.     if (/^\s/) {
  588.     @lines = split(/\n/);
  589.     for (@lines) {
  590.         1 while s
  591.         {^( [^\t]* ) \t ( \t* ) }
  592.         { $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex;
  593.         s/\\/\\e/g;
  594.         s/\A/\\&/s;
  595.     }
  596.     $lines = @lines;
  597.     makespace() unless $verbatim++;
  598.     print ".Vb $lines\n";
  599.     print join("\n", @lines), "\n";
  600.     print ".Ve\n";
  601.     $needspace = 0;
  602.     next;
  603.     }
  604.  
  605.     $verbatim = 0;
  606.  
  607.     # check for things that'll hosed our noremap scheme; affects $_
  608.     init_noremap();
  609.  
  610.     if (!/^=item/) {
  611.  
  612.     # trofficate backslashes; must do it before what happens below
  613.     s/\\/noremap('\\e')/ge;
  614.  
  615.     # first hide the escapes in case we need to
  616.     # intuit something and get it wrong due to fmting
  617.  
  618.     s/([A-Z]<[^<>]*>)/noremap($1)/ge;
  619.  
  620.     # func() is a reference to a perl function
  621.     s{
  622.         \b
  623.         (
  624.         [:\w]+ \(\)
  625.         )
  626.     } {I<$1>}gx;
  627.  
  628.     # func(n) is a reference to a man page
  629.     s{
  630.         (\w+)
  631.         (
  632.         \(
  633.             [^\s,\051]+
  634.         \)
  635.         )
  636.     } {I<$1>\\|$2}gx;
  637.  
  638.     # convert simple variable references
  639.     s/(\s+)([\$\@%][\w:]+)/${1}C<$2>/g;
  640.  
  641.     if (m{ (
  642.             [\-\w]+
  643.             \(
  644.             [^\051]*?
  645.             [\@\$,]
  646.             [^\051]*?
  647.             \)
  648.         )
  649.         }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/)
  650.     {
  651.         warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [LCI]<$1>\n";
  652.         $oops++;
  653.     }
  654.  
  655.     while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) {
  656.         warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [CB]<$1>\n";
  657.         $oops++;
  658.     }
  659.  
  660.     # put it back so we get the <> processed again;
  661.     clear_noremap(0); # 0 means leave the E's
  662.  
  663.     } else {
  664.     # trofficate backslashes
  665.     s/\\/noremap('\\e')/ge;
  666.  
  667.     }
  668.  
  669.     # need to hide E<> first; they're processed in clear_noremap
  670.     s/(E<[^<>]+>)/noremap($1)/ge;
  671.  
  672.  
  673.     $maxnest = 10;
  674.     while ($maxnest-- && /[A-Z]</) {
  675.  
  676.     # can't do C font here
  677.     s/([BI])<([^<>]*)>/font($1) . $2 . font('R')/eg;
  678.  
  679.     # files and filelike refs in italics
  680.     s/F<([^<>]*)>/I<$1>/g;
  681.  
  682.     # no break -- usually we want C<> for this
  683.     s/S<([^<>]*)>/nobreak($1)/eg;
  684.  
  685.     # LREF: a manpage(3f)
  686.     s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g;
  687.  
  688.     # LREF: an =item on another manpage
  689.     s{
  690.         L<
  691.         ([^/]+)
  692.         /
  693.         (
  694.             [:\w]+
  695.             (\(\))?
  696.         )
  697.         >
  698.     } {the C<$2> entry in the I<$1> manpage}gx;
  699.  
  700.     # LREF: an =item on this manpage
  701.     s{
  702.        ((?:
  703.         L<
  704.         /
  705.         (
  706.             [:\w]+
  707.             (\(\))?
  708.         )
  709.         >
  710.         (,?\s+(and\s+)?)?
  711.       )+)
  712.     } { internal_lrefs($1) }gex;
  713.  
  714.     # LREF: a =head2 (head1?), maybe on a manpage, maybe right here
  715.     # the "func" can disambiguate
  716.     s{
  717.         L<
  718.         (?:
  719.             ([a-zA-Z]\S+?) /
  720.         )?
  721.         "?(.*?)"?
  722.         >
  723.     }{
  724.         do {
  725.         $1     # if no $1, assume it means on this page.
  726.             ?  "the section on I<$2> in the I<$1> manpage"
  727.             :  "the section on I<$2>"
  728.         }
  729.     }gex;
  730.  
  731.     s/Z<>/\\&/g;
  732.  
  733.     # comes last because not subject to reprocessing
  734.     s/C<([^<>]*)>/noremap("${CFont_embed}${1}\\fR")/eg;
  735.     }
  736.  
  737.     if (s/^=//) {
  738.     $needspace = 0;        # Assume this.
  739.  
  740.     s/\n/ /g;
  741.  
  742.     ($Cmd, $_) = split(' ', $_, 2);
  743.  
  744.     if (defined $_) {
  745.         &escapes;
  746.         s/"/""/g;
  747.     }
  748.  
  749.     clear_noremap(1);
  750.  
  751.     if ($Cmd eq 'cut') {
  752.         $cutting = 1;
  753.     }
  754.     elsif ($Cmd eq 'head1') {
  755.         s/\s+$//;
  756.         delete $wanna_see{$_} if exists $wanna_see{$_};
  757.         print qq{.SH "$_"\n};
  758.         print qq{.IX Header "$_"\n};
  759.     }
  760.     elsif ($Cmd eq 'head2') {
  761.         print qq{.Sh "$_"\n};
  762.         print qq{.IX Subsection "$_"\n};
  763.     }
  764.     elsif ($Cmd eq 'over') {
  765.         push(@indent,$indent);
  766.         $indent += ($_ + 0) || 5;
  767.     }
  768.     elsif ($Cmd eq 'back') {
  769.         $indent = pop(@indent);
  770.         warn "$0: Unmatched =back in paragraph $. of $ARGV\n" unless defined $indent;
  771.         $needspace = 1;
  772.     }
  773.     elsif ($Cmd eq 'item') {
  774.         s/^\*( |$)/\\(bu$1/g;
  775.         print STDOUT qq{.Ip "$_" $indent\n};
  776.         print qq{.IX Item "$_"\n};
  777.     }
  778.     elsif ($Cmd eq 'pod') {
  779.         # this is just a comment
  780.     } 
  781.     else {
  782.         warn "$0: Unrecognized pod directive in paragraph $. of $ARGV: $Cmd\n";
  783.     }
  784.     }
  785.     else {
  786.     if ($needspace) {
  787.         &makespace;
  788.     }
  789.     &escapes;
  790.     clear_noremap(1);
  791.     print $_, "\n";
  792.     $needspace = 1;
  793.     }
  794. }
  795.  
  796. print <<"END";
  797.  
  798. .rn }` ''
  799. END
  800.  
  801. if (%wanna_see) {
  802.     @missing = keys %wanna_see;
  803.     warn "$0: $Filename is missing required section"
  804.     .  (@missing > 1 && "s")
  805.     .  ": @missing\n";
  806.     $oops++;
  807. }
  808.  
  809. exit;
  810. #exit ($oops != 0);
  811.  
  812. #########################################################################
  813.  
  814. sub nobreak {
  815.     my $string = shift;
  816.     $string =~ s/ /\\ /g;
  817.     $string;
  818. }
  819.  
  820. sub escapes {
  821.  
  822.     s/X<(.*?)>/mkindex($1)/ge;
  823.  
  824.     # translate the minus in foo-bar into foo\-bar for roff
  825.     s/([^0-9a-z-])-([^-])/$1\\-$2/g;
  826.  
  827.     # make -- into the string version \*(-- (defined above)
  828.     s/\b--\b/\\*(--/g;
  829.     s/"--([^"])/"\\*(--$1/g;  # should be a better way
  830.     s/([^"])--"/$1\\*(--"/g;
  831.  
  832.     # fix up quotes; this is somewhat tricky
  833.     if (!/""/) {
  834.     s/(^|\s)(['"])/noremap("$1\\*(L$2")/ge;
  835.     s/(['"])($|[\-\s,;\\!?.])/noremap("\\*(R$1$2")/ge;
  836.     }
  837.  
  838.     #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g;
  839.     #s/(?:(?!")(?:.)--(?:"))|(?:(?:")--(?!")(?:.))/\\*(--/g;
  840.  
  841.  
  842.     # make sure that func() keeps a bit a space tween the parens
  843.     ### s/\b\(\)/\\|()/g;
  844.     ### s/\b\(\)/(\\|)/g;
  845.  
  846.     # make C++ into \*C+, which is a squinched version (defined above)
  847.     s/\bC\+\+/\\*(C+/g;
  848.  
  849.     # make double underbars have a little tiny space between them
  850.     s/__/_\\|_/g;
  851.  
  852.     # PI goes to \*(PI (defined above)
  853.     s/\bPI\b/noremap('\\*(PI')/ge;
  854.  
  855.     # make all caps a teeny bit smaller, but don't muck with embedded code literals
  856.     my $hidCFont = font('C');
  857.     if ($Cmd !~ /^head1/) { # SH already makes smaller
  858.     # /g isn't enough; 1 while or we'll be off
  859.  
  860. #    1 while s{
  861. #        (?!$hidCFont)(..|^.|^)
  862. #        \b
  863. #        (
  864. #        [A-Z][\/A-Z+:\-\d_$.]+
  865. #        )
  866. #        (s?)         
  867. #        \b
  868. #    } {$1\\s-1$2\\s0}gmox;
  869.  
  870.     1 while s{
  871.         (?!$hidCFont)(..|^.|^)
  872.         (
  873.         \b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b
  874.         )
  875.     } {
  876.         $1 . noremap( '\\s-1' .  $2 . '\\s0' )
  877.     }egmox;
  878.  
  879.     }
  880. }
  881.  
  882. # make troff just be normal, but make small nroff get quoted
  883. # decided to just put the quotes in the text; sigh;
  884. sub ccvt {
  885.      local($_,$prev) = @_;
  886.      if ( /^\W+$/ && !/^\$./ ) {
  887.      ($prev && "\n") . noremap(qq{.CQ $_ \n\\&});
  888.      # what about $" ?
  889.      } else {
  890.      noremap(qq{${CFont_embed}$_\\fR});
  891.      }
  892.     noremap(qq{.CQ "$_" \n\\&});
  893. }
  894.  
  895. sub makespace {
  896.     if ($indent) {
  897.     print ".Sp\n";
  898.     }
  899.     else {
  900.     print ".PP\n";
  901.     }
  902. }
  903.  
  904. sub mkindex {
  905.     my ($entry) = @_;
  906.     my @entries = split m:\s*/\s*:, $entry;
  907.     print ".IX Xref ";
  908.     for $entry (@entries) {
  909.     print qq("$entry" );
  910.     }
  911.     print "\n";
  912.     return '';
  913. }
  914.  
  915. sub font {
  916.     local($font) = shift;
  917.     return '\\f' . noremap($font);
  918. }
  919.  
  920. sub noremap {
  921.     local($thing_to_hide) = shift;
  922.     $thing_to_hide =~ tr/\000-\177/\200-\377/;
  923.     return $thing_to_hide;
  924. }
  925.  
  926. sub init_noremap {
  927.     if ( /[\200-\377]/ ) {
  928.     warn "$0: high bit char in input stream in paragraph $. of $ARGV\n";
  929.     }
  930. }
  931.  
  932. sub clear_noremap {
  933.     my $ready_to_print = $_[0];
  934.  
  935.     tr/\200-\377/\000-\177/;
  936.  
  937.     # trofficate backslashes
  938.     # s/(?!\\e)(?:..|^.|^)\\/\\e/g;
  939.  
  940.     # now for the E<>s, which have been hidden until now
  941.     # otherwise the interative \w<> processing would have
  942.     # been hosed by the E<gt>
  943.     s {
  944.         E<    
  945.         ( [A-Za-z]+ )    
  946.         >    
  947.     } {
  948.      do {    
  949.          exists $HTML_Escapes{$1}
  950.         ? do { $HTML_Escapes{$1} }
  951.         : do {
  952.             warn "$0: Unknown escape in paragraph $. of $ARGV: ``$&''\n";
  953.             "E<$1>";
  954.         }
  955.      }
  956.     }egx if $ready_to_print;
  957. }
  958.  
  959. sub internal_lrefs {
  960.     local($_) = shift;
  961.  
  962.     s{L</([^>]+)>}{$1}g;
  963.     my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
  964.     my $retstr = "the ";
  965.     my $i;
  966.     for ($i = 0; $i <= $#items; $i++) {
  967.     $retstr .= "C<$items[$i]>";
  968.     $retstr .= ", " if @items > 2 && $i != $#items;
  969.     $retstr .= " and " if $i+2 == @items;
  970.     }
  971.  
  972.     $retstr .= " entr" . ( @items > 1  ? "ies" : "y" )
  973.         .  " elsewhere in this document";
  974.  
  975.     return $retstr;
  976.  
  977. }
  978.  
  979. BEGIN {
  980. %HTML_Escapes = (
  981.     'amp'    =>    '&',    #   ampersand
  982.     'lt'    =>    '<',    #   left chevron, less-than
  983.     'gt'    =>    '>',    #   right chevron, greater-than
  984.     'quot'    =>    '"',    #   double quote
  985.  
  986.     "Aacute"    =>    "A\\*'",    #   capital A, acute accent
  987.     "aacute"    =>    "a\\*'",    #   small a, acute accent
  988.     "Acirc"    =>    "A\\*^",    #   capital A, circumflex accent
  989.     "acirc"    =>    "a\\*^",    #   small a, circumflex accent
  990.     "AElig"    =>    '\*(AE',    #   capital AE diphthong (ligature)
  991.     "aelig"    =>    '\*(ae',    #   small ae diphthong (ligature)
  992.     "Agrave"    =>    "A\\*`",    #   capital A, grave accent
  993.     "agrave"    =>    "A\\*`",    #   small a, grave accent
  994.     "Aring"    =>    'A\\*o',    #   capital A, ring
  995.     "aring"    =>    'a\\*o',    #   small a, ring
  996.     "Atilde"    =>    'A\\*~',    #   capital A, tilde
  997.     "atilde"    =>    'a\\*~',    #   small a, tilde
  998.     "Auml"    =>    'A\\*:',    #   capital A, dieresis or umlaut mark
  999.     "auml"    =>    'a\\*:',    #   small a, dieresis or umlaut mark
  1000.     "Ccedil"    =>    'C\\*,',    #   capital C, cedilla
  1001.     "ccedil"    =>    'c\\*,',    #   small c, cedilla
  1002.     "Eacute"    =>    "E\\*'",    #   capital E, acute accent
  1003.     "eacute"    =>    "e\\*'",    #   small e, acute accent
  1004.     "Ecirc"    =>    "E\\*^",    #   capital E, circumflex accent
  1005.     "ecirc"    =>    "e\\*^",    #   small e, circumflex accent
  1006.     "Egrave"    =>    "E\\*`",    #   capital E, grave accent
  1007.     "egrave"    =>    "e\\*`",    #   small e, grave accent
  1008.     "ETH"    =>    '\\*(D-',    #   capital Eth, Icelandic
  1009.     "eth"    =>    '\\*(d-',    #   small eth, Icelandic
  1010.     "Euml"    =>    "E\\*:",    #   capital E, dieresis or umlaut mark
  1011.     "euml"    =>    "e\\*:",    #   small e, dieresis or umlaut mark
  1012.     "Iacute"    =>    "I\\*'",    #   capital I, acute accent
  1013.     "iacute"    =>    "i\\*'",    #   small i, acute accent
  1014.     "Icirc"    =>    "I\\*^",    #   capital I, circumflex accent
  1015.     "icirc"    =>    "i\\*^",    #   small i, circumflex accent
  1016.     "Igrave"    =>    "I\\*`",    #   capital I, grave accent
  1017.     "igrave"    =>    "i\\*`",    #   small i, grave accent
  1018.     "Iuml"    =>    "I\\*:",    #   capital I, dieresis or umlaut mark
  1019.     "iuml"    =>    "i\\*:",    #   small i, dieresis or umlaut mark
  1020.     "Ntilde"    =>    'N\*~',        #   capital N, tilde
  1021.     "ntilde"    =>    'n\*~',        #   small n, tilde
  1022.     "Oacute"    =>    "O\\*'",    #   capital O, acute accent
  1023.     "oacute"    =>    "o\\*'",    #   small o, acute accent
  1024.     "Ocirc"    =>    "O\\*^",    #   capital O, circumflex accent
  1025.     "ocirc"    =>    "o\\*^",    #   small o, circumflex accent
  1026.     "Ograve"    =>    "O\\*`",    #   capital O, grave accent
  1027.     "ograve"    =>    "o\\*`",    #   small o, grave accent
  1028.     "Oslash"    =>    "O\\*/",    #   capital O, slash
  1029.     "oslash"    =>    "o\\*/",    #   small o, slash
  1030.     "Otilde"    =>    "O\\*~",    #   capital O, tilde
  1031.     "otilde"    =>    "o\\*~",    #   small o, tilde
  1032.     "Ouml"    =>    "O\\*:",    #   capital O, dieresis or umlaut mark
  1033.     "ouml"    =>    "o\\*:",    #   small o, dieresis or umlaut mark
  1034.     "szlig"    =>    '\*8',        #   small sharp s, German (sz ligature)
  1035.     "THORN"    =>    '\\*(Th',    #   capital THORN, Icelandic
  1036.     "thorn"    =>    '\\*(th',,    #   small thorn, Icelandic
  1037.     "Uacute"    =>    "U\\*'",    #   capital U, acute accent
  1038.     "uacute"    =>    "u\\*'",    #   small u, acute accent
  1039.     "Ucirc"    =>    "U\\*^",    #   capital U, circumflex accent
  1040.     "ucirc"    =>    "u\\*^",    #   small u, circumflex accent
  1041.     "Ugrave"    =>    "U\\*`",    #   capital U, grave accent
  1042.     "ugrave"    =>    "u\\*`",    #   small u, grave accent
  1043.     "Uuml"    =>    "U\\*:",    #   capital U, dieresis or umlaut mark
  1044.     "uuml"    =>    "u\\*:",    #   small u, dieresis or umlaut mark
  1045.     "Yacute"    =>    "Y\\*'",    #   capital Y, acute accent
  1046.     "yacute"    =>    "y\\*'",    #   small y, acute accent
  1047.     "yuml"    =>    "y\\*:",    #   small y, dieresis or umlaut mark
  1048. );
  1049. }
  1050.  
  1051.